{This file is part of CheLive.

CheLive is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Foobar is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Foobar.  If not, see <http://www.gnu.org/licenses/>.}

{Реализует работу с окном}
unit CoreWindow;

interface

uses
	SysUtils,
{$IFDEF WIN32}
	Windows, Messages,
{$ENDIF}
{$IFDEF LINUX}
	x, xlib, xutil, keysym, glx,
{$ENDIF}
	CoreTypes, CoreMath;

const
	{Изменение состояния кнопки клавиатуры или мыши}
	WND_KEY = 1;
	{Изменение размеров окна}
	WND_SIZE = 2;
	{Изменение положения курсора}
	WND_MOTION = 3;

type
	{Изменение состояния кнопки клавиатуры или мыши @seealso(TWindowEvent)
	@member(key код кнопки)
	@member(down True если нажата)}
	TWindowKeyEvent = record
		key: Integer;
		down: Boolean;
	end;
	
	{Изменение размеров окна @seealso(TWindowEvent)
	@member(size новый размер окна (клиентской области))}
	TWindowSizeEvent = record
		size: TVec2;
	end;
	
	{Изменение положения курсора @seealso(TWindowEvent)
	@member(pos новое положение курсора (относительно клиентской области окна))}
	TWindowMotionEvent = record
		pos: TVec2;
	end;
	
	PWindowEvent = ^TWindowEvent;
	{Оконное ообщение @seealso(TWindow.AddProc)
	@seealso(TWindowKeyEvent)
	@seealso(TWindowSizeEvent)
	@seealso(TWindowMotionEvent)
	@member(param параметр пользователя)}
	TWindowEvent = record
		param: Pointer;
		
		case type_: Integer of
			WND_KEY: (key: TWindowKeyEvent);
			WND_SIZE: (size: TWindowSizeEvent);
			WND_MOTION: (motion: TWindowMotionEvent);
	end;
	
	{Процедура-обработчик оконных сообщений @seealso(TWindowEvent)}
	TWindowProc = procedure(event: PWindowEvent);
	
	{Запись для хренения обработчка оконного сообщения
	@member(proc адрес процедуры-обработчика)
	@member(param параметр пользователя)}
	TWindowProcItem = class(TListItem)
		proc: TWindowProc;
		param: Pointer;
	end;
	
	TWindowProcs = specialize TList<TWindowProcItem>;
	
	{Окно
	@member(event текущее сообщение)
	@member(wndProcs список обработчиков сообщений)
	@member(pos положение окна)
	@member(clientSize размер клиентской области окна)}
	TWindow = class
	{$IFDEF WIN32}
		wcid: TAtom; {< Класс окна}
		wc: TWndClassW;
		wnd: HWND; {< Окно}
		dc: HDC; {< Контекст устройства}
	{$ENDIF}
	{$IFDEF LINUX}
		wnd: x.TWindow; {< Окно}
		vi: PXVisualInfo; {< Формат пикселя}
		attrs: array[0..10] of Integer; {< Атрибуты выбора формата пикселя}
		destroyAtom, protocolsAtom: TAtom;
		cursor: TCursor; {< Графический курсор}
	{$ENDIF}
		killed: Boolean;
		event: TWindowEvent;
		wndProcs: TWindowProcs;
		pos, clientSize: TVec2;
		
		{Инициализация
		@param(title заголовок)
		@param(w ширина)
		@param(h высота)
		@param(haveBorder имеет ли окно бордюры)
		@param(resizeable может ли окно менять размеры)
		@returns(True если инициализация прошла успешно)}
		function Init(title: String; w, h: Integer; haveBorder, resizeable: Boolean): Boolean;
		{Обработка сообщений
		@returns(False если получено сообщение закрытия окна)}
		function PollEvents: Boolean;
		{Обработка теущего сообщения (используется только самим классом)}
		procedure ProcessEvent;
		{Переключение буферов (вывод того что было нарисовано OpenGL)}
		procedure SwapBuffers;
		{Добавление процедуры-обработчика сообшений @seealso(TWindowEvent)
		@param(proc адрес процедуры-обработчика)
		@param(param параметр пользователя (будет передано в обработчик))}
		procedure AddProc(proc: TWindowProc; param: Pointer = nil);
		{Показать курсор
		@param(show если True то курсор будет показан, иначе спятан)}
		procedure ShowCursor(show: Boolean);
		{Закрыть окно}
		procedure Close;

		constructor Create;
		destructor Destroy; override;
	end;

var
	wnd: TWindow;

implementation

uses
	CoreConsole, CoreDisplay, CoreInput;

constructor TWindow.Create;
begin
{$IFDEF WIN32}
	wcid := 0;
	wnd := 0;
	dc := 0;
{$ENDIF}
{$IFDEF LINUX}
	disp.disp := nil;
	wnd := 0;
{$ENDIF}
	
	wndProcs := TWindowProcs.Create;
end;

destructor TWindow.Destroy;
begin
	FreeAndNil(wndProcs);

{$IFDEF WIN32}
	if dc <> 0 then ReleaseDC(wnd, dc);
	if wnd <> 0 then DestroyWindow(wnd);
	if wcid <> 0 then UnregisterClassW(wc.lpszClassName, wc.hInstance);
{$ENDIF}
{$IFDEF LINUX}
	if wnd <> 0 then XDestroyWindow(disp.disp, wnd);
{$ENDIF}
end;

{$IFDEF WIN32}
function WndProc(wnd_: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
	rect: Windows.TRect;
begin
	Result := 0;
	
	wnd.event.type_ := 0;
	
	case msg of
		WM_CLOSE:
		begin
			wnd.killed := True;
		end;
		
		WM_KEYDOWN:			begin wnd.event.type_ := WND_KEY; wnd.event.key.key := wParam; wnd.event.key.down := True; end;
		WM_KEYUP:			begin wnd.event.type_ := WND_KEY; wnd.event.key.key := wParam; wnd.event.key.down := False; end;
		WM_LBUTTONDOWN:	begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_L; wnd.event.key.down := True; end;
		WM_LBUTTONUP: 		begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_L; wnd.event.key.down := False; end;
		WM_MBUTTONDOWN:	begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_M; wnd.event.key.down := True; end;
		WM_MBUTTONUP:		begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_M; wnd.event.key.down := False; end;
		WM_RBUTTONDOWN:	begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_R; wnd.event.key.down := True; end;
		WM_RBUTTONUP:		begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_R; wnd.event.key.down := False; end;
		
		WM_MOUSEMOVE:
		begin
			wnd.event.type_ := WND_MOTION;
			wnd.event.motion.pos := Vec2(LOWORD(lParam), HIWORD(lParam));
		end;

		WM_SIZE:
		begin
			wnd.event.type_ := WND_SIZE;
			wnd.event.size.size := Vec2(LOWORD(lParam), HIWORD(lParam));
			
			GetWindowRect(wnd_, rect);
			
			wnd.clientSize := Vec2(LOWORD(lParam), HIWORD(lParam));
		end;

		else Result := DefWindowProc(wnd_, msg, wParam, lParam);
	end;
	
	if wnd.event.type_ <> 0 then
	begin
		wnd.ProcessEvent;
	end;
end;
{$ENDIF}

function TWindow.Init(title: String; w, h: Integer; haveBorder, resizeable: Boolean): Boolean;
var
{$IFDEF WIN32}
	style: Cardinal;
	rect: Windows.TRect;
{$ENDIF}
{$IFDEF LINUX}
	root: Cardinal;
	swa: TXSetWindowAttributes;
	titleChar: PChar;
	titleProp: TXTextProperty;
	sh: TXSizeHints;
{$ENDIF}
begin
	Result := False;
	
	if w = 0 then w := disp.modes[disp.curMode].w;
	if h = 0 then h := disp.modes[disp.curMode].h;

{$IFDEF WIN32}
	FillChar(wc, SizeOf(wc), 0);

	with wc do
	begin
		lpfnWndProc := @WndProc;
		hInstance := GetModuleHandle(nil);
		hCursor := LoadCursor(0, IDC_ARROW);
		hbrBackground := COLOR_WINDOW;
		lpszClassName := 'TWindow';
	end;

	wcid := RegisterClassW(wc);

	if wcid = 0 then
	begin
		//error
		Exit;
	end;

	if haveBorder then
	begin
		style := WS_OVERLAPPEDWINDOW and not WS_THICKFRAME and not WS_MAXIMIZEBOX;

		if resizeable then
		begin
			style := style or WS_THICKFRAME or WS_MAXIMIZEBOX;
		end;
	end else
	begin
		style := WS_POPUP;
	end;
	
	FillChar(rect, SizeOf(rect), 0);
	
	rect.Right := w;
	rect.Bottom := h;
	
	AdjustWindowRect(rect, style, False);
	
	wnd := CreateWindowExW(0, wc.lpszClassName, PWideChar(UTF8ToUnicode(title)), style, 0, 0,
		rect.Right - rect.Left, rect.Bottom - rect.Top, 0, 0, wc.hInstance, nil);

	if wnd = 0 then
	begin
		//error
		Exit;
	end;
	
	MoveWindow(wnd, 0, 0, rect.Right - rect.Left, rect.Bottom - rect.Top, True);

	dc := GetDC(wnd);

	if dc = 0 then
	begin
		con.Msg('#Не удается создать окно');
		Exit;
	end;

	ShowWindow(wnd, SW_SHOW);
	UpdateWindow(wnd);
{$ENDIF}
{$IFDEF LINUX}
	attrs[0] := GLX_RGBA;
	attrs[1] := GLX_DOUBLEBUFFER;
	attrs[2] := GLX_RED_SIZE;
	attrs[3] := 8;
	attrs[4] := GLX_GREEN_SIZE;
	attrs[5] := 8;
	attrs[6] := GLX_BLUE_SIZE;
	attrs[7] := 8;
	attrs[8] := GLX_ALPHA_SIZE;
	attrs[9] := 8;
	attrs[10] := None;

	vi := glXChooseVisual(disp.disp, DefaultScreen(disp.disp), @attrs[0]);

	if vi = nil then
	begin
		con.Msg('#glXChooseVisual');
		Exit;
	end;

	root := RootWindow(disp.disp, vi^.screen);

	FillChar(swa, SizeOf(swa), 0);

	swa.colormap   := XCreateColormap(disp.disp, root, vi^.visual, AllocNone);
	swa.event_mask := ButtonPressMask or ButtonReleaseMask or
		PointerMotionMask or KeyPressMask or KeyReleaseMask or StructureNotifyMask;

	wnd := XCreateWindow(disp.disp, root, 0, 0, w, h, 0, vi^.depth, InputOutput, vi^.visual,
		CWColormap or CWEventMask or CWX or CWY or CWBackPixel or CWBorderPixel, @swa);

	if wnd = 0 then
	begin
		con.Msg('#Не удается создать окно');
		Exit;
	end;
	
	titleChar := PChar(title);
	Xutf8TextListToTextProperty(disp.disp, @titleChar, 1, XUTF8StringStyle, @titleProp);
	XSetWMName(disp.disp, wnd, @titleProp);
	
	XMapRaised(disp.disp, wnd);
	
	XResizeWindow(disp.disp, wnd, w, h);
	
	if not resizeable then
	begin
		sh.flags := PMinSize or PMaxSize;
		sh.min_width := w;
		sh.max_width := w;
		sh.min_height := h;
		sh.max_height := h;
		
		XSetWMNormalHints(disp.disp, wnd, @sh);
	end;

	destroyAtom := XInternAtom(disp.disp, 'WM_DELETE_WINDOW', True);
	protocolsAtom := XInternAtom(disp.disp, 'WM_PROTOCOLS', True);

	XSetWMProtocols(disp.disp, wnd, @destroyAtom, 1);
{$ENDIF}
	
	clientSize := Vec2(w, h);

	Result := True;
end;

{$IFDEF LINUX}
function XKeyToScancode(xkey: PXKeyEvent): Integer;
var
	key: Integer;
begin
	key := XLookupKeysym(xkey, 0);
	
	case key of	
		XK_BackSpace:						Result := IK_BACKSPACE;
		XK_Tab:								Result := IK_TAB;
		XK_Shift_L, XK_Shift_R:			Result := IK_SHIFT;
		XK_Control_L, XK_Control_R:	Result := IK_CONTROL;
		XK_Alt_L, XK_Alt_R:				Result := IK_ALT;
		XK_Pause:							Result := IK_PAUSE;
		//IK_CAPITAL
		XK_Escape:							Result := IK_ESCAPE;
		XK_Space:							Result := IK_SPACE;
		XK_Return:							Result := IK_ENTER;
		XK_Page_Up:							Result := IK_PAGEUP;
		XK_Page_DOWN:						Result := IK_PAGEDOWN;
		XK_End:								Result := IK_END;
		XK_Home:								Result := IK_HOME;
		XK_Left:								Result := IK_LEFT;
		XK_Up:								Result := IK_UP;
		XK_Right:							Result := IK_RIGHT;
		XK_Down:								Result := IK_DOWN;
		XK_Print:							Result := IK_SNAPSHOT;
		XK_Insert:							Result := IK_INSERT;
		XK_Delete:							Result := IK_DELETE;
		XK_multiply:						Result := IK_MULTIPLY;
		XK_plus:								Result := IK_ADD;
		XK_minus:							Result := IK_SUBSTRUCT;
		XK_comma:							Result := IK_DECIMAL;
		XK_division:						Result := IK_DIVIDE;
		XK_grave:							Result := IK_TYLDA;
		
		XK_F1: Result := IK_F1;
		XK_F2: Result := IK_F2;
		XK_F3: Result := IK_F3;
		XK_F4: Result := IK_F4;
		XK_F5: Result := IK_F5;
		XK_F6: Result := IK_F6;
		XK_F7: Result := IK_F7;
		XK_F8: Result := IK_F8;
		XK_F9: Result := IK_F9;
		XK_F10: Result := IK_F10;
		XK_F11: Result := IK_F11;
		XK_F12: Result := IK_F12;
		
		else
		begin
			if (key >= XK_0) and (key <= XK_9) then Result := IK_0 + key - XK_0 else
			if (key >= XKc_A) and (key <= XKc_Z) then Result := IK_A + key - XKc_A else
			if (key >= XK_A) and (key <= XK_Z) then Result := IK_A + key - XK_A else Result := 0;
		end;
	end;
end;

function HandleEvent(event: PXEvent): Boolean;
begin
	Result := True;	
	
	case event^._type of
		KeyPress: begin wnd.event.type_ := WND_KEY; wnd.event.key.key := XKeyToScancode(@event^.xkey); wnd.event.key.down := True; end;
		KeyRelease: begin wnd.event.type_ := WND_KEY; wnd.event.key.key := XKeyToScancode(@event^.xkey); wnd.event.key.down := False; end;
		
		ButtonPress:
		begin
			case event^.xbutton.button of
				Button1: begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_L; wnd.event.key.down := True; end;
				Button2: begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_M; wnd.event.key.down := True; end;
				Button3: begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_R; wnd.event.key.down := True; end;
			end;
		end;
		
		ButtonRelease:
		begin
			case event^.xbutton.button of
				Button1: begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_L; wnd.event.key.down := False; end;
				Button2: begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_M; wnd.event.key.down := False; end;
				Button3: begin wnd.event.type_ := WND_KEY; wnd.event.key.key := IK_MOUSE_R; wnd.event.key.down := False; end;
			end;
		end;
		
		MotionNotify:
		begin
			wnd.event.type_ := WND_MOTION;
			wnd.event.motion.pos := Vec2(event^.xmotion.x, event^.xmotion.y);
		end;
		
		ConfigureNotify:
		begin
			wnd.event.type_ := WND_SIZE;
			wnd.event.size.size := Vec2(event^.xconfigure.width, event^.xconfigure.height);
			wnd.clientSize := Vec2(event^.xconfigure.width, event^.xconfigure.height);
		end;
		
		ClientMessage:
		begin
			if (event^.xclient.message_type = wnd.protocolsAtom) and
				(event^.xclient.data.l[0] = wnd.destroyAtom) then
			begin
				wnd.killed := True;
				Result := False;
			end;
		end;
	end;
	
	wnd.ProcessEvent;
end;
{$ENDIF}

function TWindow.PollEvents: Boolean;
var
{$IFDEF WIN32}
	msg: TMsg;
{$ENDIF}
{$IFDEF LINUX}
	event_: TXEvent;
{$ENDIF}
begin
	Result := True;
	
	if killed then
	begin
		Result := False;
		Exit;
	end;

{$IFDEF WIN32}
	while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
	begin
		TranslateMessage(msg);
		DispatchMessage(msg);
	end;
{$ENDIF}
{$IFDEF LINUX}
	while XPending(disp.disp) <> 0 do
	begin
		XNextEvent(disp.disp, @event_);
		
		if not HandleEvent(@event_) then
		begin
			Result := False;
			Exit;
		end;
	end;
{$ENDIF}
end;

procedure TWindow.ProcessEvent;
var
	i: Integer;
begin
	if event.type_ = 0 then
	begin
		Exit;
	end;
	
	for i := 0 to wndProcs.size - 1 do
	begin
		if wndProcs[i] <> nil then
		begin
			event.param := wndProcs[i].param;
			wndProcs[i].proc(@event);
		end;
	end;
end;

procedure TWindow.SwapBuffers;
begin
{$IFDEF WIN32}
	Windows.SwapBuffers(dc);
{$ENDIF}
{$IFDEF LINUX}
	glXSwapBuffers(disp.disp, wnd);
{$ENDIF}
end;

procedure TWindow.AddProc(proc: TWindowProc; param: Pointer = nil);
var
	wndProc: TWindowProcItem;
begin
	wndProc := TWindowProcItem.Create;
	wndProc.proc := proc;
	wndProc.param := param;

	wndProcs.Add(wndProc);
end;

procedure TWindow.ShowCursor(show: Boolean);
{$IFDEF LINUX}
var
	mask: TPixmap;
	color: TXColor;
{$ENDIF}
begin
{$IFDEF WIN32}
	Windows.ShowCursor(show);
{$ENDIF}
{$IFDEF LINUX}
	if show then
	begin
		if cursor <> None then
		begin
			XFreeCursor(disp.disp, cursor);
			
			cursor := None;
			
			XDefineCursor(disp.disp, wnd, cursor);
		end;
	end else
	begin
		FillChar(color, SizeOf(color), 0);
		
		mask := XCreatePixmap(disp.disp, wnd, 1, 1, 1);
		cursor := XCreatePixmapCursor(disp.disp, mask, mask, @color, @color, 0, 0);
		
		XDefineCursor(disp.disp, wnd, cursor);
	end;
{$ENDIF}
end;

procedure TWindow.Close;
begin
	killed := True;
end;

end.
